home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1997 April: Mac OS SDK / Dev.CD Apr 97 SDK1.toast / Development Kits (Disc 1) / Multiprocessing SDK / Sample Code / MPHelloWorld (Pascal) / sources / MPHelloWorld.p < prev   
Encoding:
Text File  |  1996-12-09  |  6.7 KB  |  213 lines  |  [TEXT/PJMM]
  1. {This file was processed by Dan's Source Converter}
  2. {version 1.3 (this version modified by Ingemar Ragnemalm)}
  3. {converted to Pascal by Matthew Xavier Mora mxmora@apple.com}
  4. { 12-9-96 Tested on 9500/180MP}
  5.  
  6. program MPHelloWorld;
  7.  
  8.     uses
  9.         Types, Memory,QuickDraw,Fonts,Windows,Menus,TextEdit,Dialogs,MP;
  10.     var
  11.         err: Integer;
  12. {------------------------------------------------------------------------}
  13.     procedure InitMac;
  14. {------------------------------------------------------------------------}
  15.     begin
  16.         InitGraf(@qd.thePort);
  17.         InitFonts;         { foreground only }
  18.         InitWindows;     { foreground only }
  19.         InitMenus;         { foreground only }
  20.         TEInit;         { foreground only }
  21.         InitDialogs(nil); { foreground only }
  22.         {SetApplLimit(sp-stack_size);} {Don't do this on PPC}
  23.         MaxApplZone;
  24.         MoreMasters;
  25.         MoreMasters;
  26.     end;
  27.  
  28. {------------------------------------------------------------------------}
  29.     procedure sendString (queue: MPQueueID; var theString: Str255);
  30. {------------------------------------------------------------------------}
  31. {  Send the string through the queue one character at a time.}
  32.         var
  33.             err: OSStatus;
  34.             i: integer;
  35.             theChar: char;
  36.     begin
  37.  
  38.         for i := 1 to integer(theString[0]) do
  39.             begin
  40.                 theChar := thestring[i];
  41.                 err := MPNotifyQueue(queue, longint(theChar), nil, nil);
  42.             end;
  43.         theChar := chr(0);
  44.         err := MPNotifyQueue(queue, longint(theChar), nil, nil);            (* Send the final null character. *)
  45.     end;
  46.  
  47. {------------------------------------------------------------------------}
  48.     procedure receiveString (queue: MPQueueID; var thestring: Str255);
  49. {------------------------------------------------------------------------}
  50. {  Reassemble a string being transferred over the queue and return it to the caller.}
  51.     var
  52.         first    : longint;        {* The first word of the message. *}
  53.         second    : longint;        {* The second word of the message. *}
  54.         third    : longint;        {* The third word of the message. *}
  55.         i        : integer;
  56.         err        : integer;
  57.  
  58.     begin
  59.         i := 1;
  60.         while (true) do
  61.             begin
  62.                 err := MPWaitOnQueue(queue, @first, @second, @third, kDurationForever);
  63.  
  64.                 if (first = 0) then
  65.                     begin
  66.                         theString[0] := char(i - 1);
  67.                         exit(receiveString);
  68.                     end
  69.                 else
  70.                     begin
  71.                         theString[i] := char(first);
  72.                     end;
  73.                 i := i + 1;
  74.             end;
  75.     end;
  76.  
  77. {------------------------------------------------------------------------}
  78.     function HelloWorld (parameter: MPQueueID): OSStatus;
  79. {------------------------------------------------------------------------}
  80.     var
  81.         queue: MPQueueID;
  82.         tempStr: Str255;
  83.         count:longint;
  84.     begin
  85.         queue     := parameter;
  86.         tempStr := 'Hello, World from Pascal!';
  87.         count    := MPProcessors;
  88.         tempStr := tempStr +  chr(13) + 'Processors: ' + stringof(count); {not sure if stringof is safe to cakll here}
  89.         sendString(queue, tempStr);
  90.         HelloWorld := noErr;
  91.     end;
  92.  
  93. {------------------------------------------------------------------------}
  94.     function failure (var annotation: Str255; routine: Str255; status: OSStatus): Integer;
  95. {------------------------------------------------------------------------}
  96.     var
  97.         tempStr: Str255;
  98.         itemHit: integer;
  99.     begin
  100. (*    printf('Uh oh.  %s%s%s returned %s [%d].\n',}
  101. {         (annotation) ? annotation : '',}
  102. {         (routine) ? routine : '',}
  103. {         (routine) ? '()' : 'A routine',}
  104. {         _MPStatusCString(status),}
  105. {         status);}
  106. {*)
  107.  
  108.  
  109. {}
  110.     {tempStr:=_MPStatusPString(status);}
  111.  
  112.         DebugStr(annotation);
  113.  
  114. {    ParamText(tempStr,'','','');}
  115. {    itemHit:=Alert(128,nil);}
  116.  
  117.         failure := 1;
  118.     end;
  119.  
  120. {------------------------------------------------------------------------}
  121.     function Test: Integer;
  122. {------------------------------------------------------------------------}
  123.     var
  124.         status, err: OSStatus;                    (* We'll use this to test the outcome of each MP function. *)
  125.         terminationQueue: MPQueueID;        (* This queue will report the completion of the task. *)
  126.         communicationQueue: MPQueueID;    (* This queue will be used to communicate between the app and the task. *)
  127.         task: MPTaskID;                        (* This will be the ID of the task we create. *)
  128.         myString: Str255;
  129.         itemHit: Integer;
  130.         tempStr: Str255;
  131.  
  132.     begin
  133.  
  134.         if (not MPLibraryIsLoaded) then
  135.             begin
  136.                 ParamText('Can''t run without the ', MPLibraryPName, ' shared library.', '');
  137.                 itemHit := Alert(129, nil);
  138.                 exit(Test);
  139.             end;
  140.  
  141.         status := MPCreateQueue(terminationQueue);    (* Create the queue which will report the completion of the task. *)
  142.         if (status <> noErr) then
  143.             begin
  144.                 tempStr := 'Cannot create the termination queue:\n';
  145.                 Test := failure(tempStr, 'MPCreateQueue', status);
  146.                 exit(Test);
  147.             end;
  148.  
  149.         status := MPCreateQueue(communicationQueue);    (* Create the queue we'll use to communicate with. *)
  150.         if (status <> noErr) then
  151.             begin
  152.                 err := MPDeleteQueue(terminationQueue);
  153.                 tempStr := 'Cannot create the communication queue:\n    ';
  154.                 Test := failure(tempStr, 'MPCreateQueue', status);
  155.                 exit(Test);
  156.             end;
  157.  
  158.         status := MPCreateTask(HelloWorld, communicationQueue, kMPUseDefaultStackSize, terminationQueue, nil, nil, kMPNormalTaskOptions, task);                (* This is the task function. *)
  159.     (* This is the parameter to the task function. *)
  160.     (* We'll use whatever the MP system software gives us. *)
  161.     (* We'll use this to sense task completion. *)
  162.     (* We won't use the first part of the termination message. *)
  163.     (* We won't use the second part of the termination message. *)
  164.     (* Use the normal task options. (Currently this *must* be zero!) *)
  165.     (* Here's where the ID of the new task will go. *)
  166.  
  167.         if (status <> noErr) then
  168.             begin
  169.                 err := MPDeleteQueue(terminationQueue);
  170.                 err := MPDeleteQueue(communicationQueue);
  171.                 tempStr := '';
  172.                 Test := failure(tempStr, 'MPCreateTask', status);
  173.                 exit(Test);
  174.             end;
  175.  
  176.         receiveString(communicationQueue, myString);
  177.         ParamText(myString, 'brought to you by Matthew Xavier Mora mxmora@apple.com', 'Developer Technical Support,', 'MW Pascal and MP.p interfaces');
  178.  
  179.         itemHit := Alert(128, nil);
  180.  
  181.   { Wait for the task to complete: }
  182.         status := MPWaitOnQueue(terminationQueue, nil, nil, nil, kDurationForever);
  183.         if (status <> noErr) then
  184.             begin
  185.                 tempStr := 'While waiting for task completion:\n    ';
  186.                 err := failure(tempStr, 'MPWaitOnQueue', status);
  187.             end;
  188.  
  189.         status := MPDeleteQueue(terminationQueue);
  190.         if (status <> noErr) then
  191.             begin
  192.                 tempStr := 'Can''t delete the termination queue:';
  193.                 err := failure(tempStr, 'MPDeleteQueue', status);
  194.             end;
  195.  
  196.         status := MPDeleteQueue(communicationQueue);
  197.         if (status <> noErr) then
  198.             begin
  199.                 tempStr := 'Can''t delete the communication queue: ';
  200.                 err := failure(tempStr, 'MPDeleteQueue', status);
  201.             end;
  202.  
  203.         Test := 0;
  204.         Exit(Test);
  205.     end;
  206.  
  207. {------------------------------------------------------------------------------------}
  208. {Start of main}
  209. {------------------------------------------------------------------------------------}
  210. begin
  211.     InitMac;
  212.     err := Test;
  213. end.